home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / outnam.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.8 KB  |  82 lines
  1.       subroutine outnam(loc,ktype,string,ipos)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine constructs the 'name' for the output variable indi-
  5. c cated by loc, adding the characters to the character array 'string',
  6. c beginning with the position marked by ipos.
  7. c
  8. c spice version 2g.6  sccsid=tabinf 3/15/83
  9.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  10.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  11.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  12.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  13.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  14.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  15.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  16.      7   irowno,jcolno,nttbr,nttar,lvntmp
  17. c spice version 2g.6  sccsid=blank 3/15/83
  18.       common /blank/ value(200000)
  19.       integer nodplc(64)
  20.       complex cvalue(32)
  21.       equivalence (value(1),nodplc(1),cvalue(1))
  22. c
  23.       dimension string(1)
  24.       dimension aout(19),lenout(19),aopt(5),lenopt(5)
  25.       data aout / 6hv     , 6hvm    , 6hvr    , 6hvi    , 6hvp    ,
  26.      1            6hvdb   , 6hi     , 6him    , 6hir    , 6hii    ,
  27.      2            6hip    , 6hidb   , 6honoise, 6hinoise, 6hhd2   ,
  28.      1            6hhd3   , 6hdim2  , 6hsim2  , 6hdim3   /
  29.       data lenout / 1,2,2,2,2,3,1,2,2,2,2,3,6,6,3,3,4,4,4 /
  30.       data aopt / 5hmag  , 5hreal , 5himag , 5hphase, 5hdb    /
  31.       data lenopt / 3,4,4,5,2 /
  32.       data alprn, acomma, arprn, ablnk / 1h(, 1h,, 1h), 1h  /
  33. c
  34. c
  35.       ioutyp=nodplc(loc+5)
  36.       if (ioutyp.ge.2) go to 10
  37.       lout=ktype+ioutyp*6
  38.       go to 20
  39.    10 lout=ioutyp+11
  40.    20 call move(string,ipos,aout(lout),1,lenout(lout))
  41.       ipos=ipos+lenout(lout)
  42.       if (ioutyp.ge.2) go to 200
  43.       call move(string,ipos,alprn,1,1)
  44.       ipos=ipos+1
  45.       if (ioutyp.ne.0) go to 100
  46.       node1=nodplc(loc+2)
  47.       call alfnum(nodplc(junode+node1),string,ipos)
  48.       node2=nodplc(loc+3)
  49.       if (node2.eq.1) go to 30
  50.       call move(string,ipos,acomma,1,1)
  51.       ipos=ipos+1
  52.       call alfnum(nodplc(junode+node2),string,ipos)
  53.    30 call move(string,ipos,arprn,1,1)
  54.       ipos=ipos+1
  55.       go to 1000
  56. c
  57.   100 locv=nodplc(loc+1)
  58.       anam=value(locv)
  59.       achar=ablnk
  60.       do 110 i=1,8
  61.       call move(achar,1,anam,i,1)
  62.       if (achar.eq.ablnk) go to 120
  63.       call move(string,ipos,achar,1,1)
  64.       ipos=ipos+1
  65.   110 continue
  66.   120 call move(string,ipos,arprn,1,1)
  67.       ipos=ipos+1
  68.       go to 1000
  69. c
  70.   200 if (ktype.eq.1) go to 1000
  71.       call move(string,ipos,alprn,1,1)
  72.       ipos=ipos+1
  73.       call move(string,ipos,aopt(ktype-1),1,lenopt(ktype-1))
  74.       ipos=ipos+lenopt(ktype-1)
  75.       call move(string,ipos,arprn,1,1)
  76.       ipos=ipos+1
  77. c
  78. c  finished
  79. c
  80.  1000 return
  81.       end
  82.